﻿unit NewReestrFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxGraphics, cxControls,
  cxLookAndFeelPainters, cxCustomData, cxFilter,
  cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxClasses,
  FIBQuery, pFIBCacheQueries,
  cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView,
  cxGrid, cxPC, dxBar,
  cxGridExportLink,
  dxRibbonForm, scin,dxSkinsForm,cxLookAndFeels,dxSkinsDefaultPainters,
  cxLocalization, JvFormPlacement, JvComponentBase, JvAppStorage,
  JvAppIniStorage, FIBDataSet, pFIBDataSet, cxGridCustomPopupMenu,
  cxGridPopupMenu, Menus, JvDialogs, cxButtonEdit, cxBarEditItem,
  cxContainer, cxDropDownEdit, cxCalendar, cxLabel,
  cxTextEdit, cxMaskEdit, cxLookupEdit, cxDBLookupEdit, cxDBLookupComboBox,
  StdCtrls, cxRadioGroup, cxGroupBox, Mask, JvExMask, JvToolEdit, cxButtons,
  FIBDatabase, pFIBDatabase, cxSpinEdit, JvSpin, dxSkinsCore, dxSkinSeven,
  dxSkinscxPCPainter, cxStyles, cxData, dxSkinsdxBarPainter,
  dxSkinsdxRibbonPainter, dxRibbon, dxRibbonGallery, dxSkinMcSkin,
  cxPropertiesStore, dxSkinOffice2010Black, dxSkinOffice2010Blue,
  dxSkinOffice2010Silver, dxmdaset, QImport3, QImport3Xlsx, QImport3XLS,
  pFIBScripter;

type
  TNewReestrForm = class(Tdxcustomribbonform)
    bar1: TdxBarManager;
    pgc1: TcxPageControl;
    sht1: TcxTabSheet;
    v1: TcxGridDBTableView;
    l1: TcxGridLevel;
    grd1: TcxGrid;
    cxlclzr1: TcxLocalizer;
    DataSet1: TpFIBDataSet;
    btn_get: TdxBarButton;
    ds1: TDataSource;
    clcode: TcxGridDBColumn;
    cllasttime: TcxGridDBColumn;
    clkontragent: TcxGridDBColumn;
    clview_kontragent: TcxGridDBColumn;
    clnote: TcxGridDBColumn;
    cld1: TcxGridDBColumn;
    cld2: TcxGridDBColumn;
    sht2: TcxTabSheet;
    v2: TcxGridDBTableView;
    l2: TcxGridLevel;
    grd2: TcxGrid;
    DataSet2: TpFIBDataSet;
    ds2: TDataSource;
    cl2code: TcxGridDBColumn;
    cl2reestr: TcxGridDBColumn;
    cl2accode: TcxGridDBColumn;
    cl2summa: TcxGridDBColumn;
    cl2lasttime: TcxGridDBColumn;
    pmn1: TcxGridPopupMenu;
    pm1: TPopupMenu;
    Excel1: TMenuItem;
    Excel2: TMenuItem;
    dlg1: TJvSaveDialog;
    pmn2: TcxGridPopupMenu;
    dlg2: TJvOpenDialog;
    btn1: TdxBarButton;
    btn_load: TdxBarButton;
    sht3: TcxTabSheet;
    grpbx1: TcxGroupBox;
    rdgrp1: TcxRadioGroup;
    rb1: TcxRadioButton;
    rb2: TcxRadioButton;
    cbb1: TcxLookupComboBox;
    lbl1: TcxLabel;
    lbl2: TcxLabel;
    lbl3: TcxLabel;
    dtdt1: TcxDateEdit;
    dtdt2: TcxDateEdit;
    DataSet3: TpFIBDataSet;
    ds3: TDataSource;
    edt_file: TJvFilenameEdit;
    lbl4: TcxLabel;
    btn_insert: TcxButton;
    trn1: TpFIBTransaction;
    lbl5: TcxLabel;
    edt2: TcxTextEdit;
    clusr: TcxGridDBColumn;
    edt3: TJvSpinEdit;
    RibbonTab1: TdxRibbonTab;
    Ribbon: TdxRibbon;
    bar1Bar1: TdxBar;
    DropDownGallery1: TdxRibbonDropDownGallery;
    edt_note: TcxTextEdit;
    lbl6: TcxLabel;
    clcnt: TcxGridDBColumn;
    prpstor1: TcxPropertiesStore;
    btn_delete: TdxBarButton;
    grb1: TcxGroupBox;
    edt_index: TJvFilenameEdit;
    cbb_reestr: TcxLookupComboBox;
    btn_loadIndex: TcxButton;
    ds_reestr: TpFIBDataSet;
    src_reestr: TDataSource;
    mt_index: TdxMemData;
    xlsImp2: TQImport3XLS;
    script1: TpFIBScripter;    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btn_getClick(Sender: TObject);
    procedure v1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure sht1Enter(Sender: TObject);
    procedure sht2Enter(Sender: TObject);
    procedure Excel1Click(Sender: TObject);
    procedure Excel2Click(Sender: TObject);
    procedure btned1PropertiesButtonClick(Sender: TObject;
      AButtonIndex: Integer);
    procedure btn1Click(Sender: TObject);
    procedure sht3Enter(Sender: TObject);
    procedure btn_loadClick(Sender: TObject);
    procedure cbb1PropertiesChange(Sender: TObject);
    procedure btn_insertClick(Sender: TObject);
    procedure edt3Change(Sender: TObject);
    procedure v1DblClick(Sender: TObject);
    procedure v2DataControllerFilterBeforeChange(
      Sender: TcxDBDataFilterCriteria; ADataSet: TDataSet;
      const AFilterText: string);
    procedure FormActivate(Sender: TObject);
    procedure btn_deleteClick(Sender: TObject);
    procedure btn_loadIndexClick(Sender: TObject);
  private
    { Private declarations }
    NotExist :TStringList;
    function CreateHead(kontragent :string; d1,d2 :TDateTime;
                        cnt :integer) :integer;
    procedure InsertData(reestr :Integer; ls :TStringList);
    procedure OpenSpec(code :string);
    procedure LoadFileData(fname,kontragent :string;
                           d1,d2 :TDateTime; full :Boolean);
    procedure DeleteReestr(cod :string);
    function IsExist(AcCode :string) :boolean;
    procedure NotExistSchet(AcCode :string);
    function CheckParam :Boolean;
    procedure MemIndex;
    function MakeScript :integer;
    function ExScript :boolean;
  public
    { Public declarations }
  end;


var
  NewReestrForm: TNewReestrForm;

implementation

uses  cmUtils, GetSprForm, DModule;

{$R *.dfm}

//загрузка файла
procedure TNewReestrForm.btn1Click(Sender: TObject);
begin
 Close;
end;

procedure TNewReestrForm.btned1PropertiesButtonClick(Sender: TObject;
  AButtonIndex: Integer);
begin
  if dlg2.Execute then
 begin
 // btned1.EditValue:=dlg2.FileName;
 end;
end;
{------------------------------------------------------------------------------
  btn_deleteClick:  Удаляем реестр
_______________________________________________________________________________}
procedure TNewReestrForm.btn_deleteClick(Sender: TObject);
var
  cod,s :string;
begin
  cod:=GetSelected('code',grd1);
  if cod<>'' then
  begin
    s:='Выдействительно хотите удалить реестр №'+cod+' ?';
    if Application.MessageBox(PChar(s),
      'Внимание!!!', MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON2) = IDOK then
    begin
      DeleteReestr(cod);
    end;
  end;
end;

procedure TNewReestrForm.DeleteReestr(cod :string);
var
  Q :TFIBQuery;
begin
  Q:=GetQueryForUse(trn1,'Delete from n_reestr where code=:cod');
  Q.ParamByName('cod').AsInteger:=StrToInt(cod);
  Q.ExecQuery;
  trn1.Commit;
  trn1.StartTransaction;
  DataSet1.CloseOpen(true);
  FreeQueryForUse(Q);
end;
{------------------------------------------------------------------------------}

procedure TNewReestrForm.btn_getClick(Sender: TObject);
begin
 DataSet1.CloseOpen(false);
end;


procedure TNewReestrForm.Excel1Click(Sender: TObject);
begin
 if dlg1.Execute then
 ExportGridToExcel(dlg1.FileName,grd2,false,True,True,'xls');
end;

procedure TNewReestrForm.Excel2Click(Sender: TObject);
begin
 if dlg1.Execute then
 ExportGridToExcel(dlg1.FileName,grd2,true,True,True,'xls');
end;

procedure TNewReestrForm.FormActivate(Sender: TObject);
begin
  SetTabActive('rep',True);
end;

procedure TNewReestrForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 NotExist.Free;
 RemoveBtn(Name);
 Action:=caFree;
end;

procedure TNewReestrForm.FormCreate(Sender: TObject);
begin
 if FileExists(ExtractFilePath(Application.ExeName)+'lang\rus.ini') then
 begin
  cxlclzr1.FileName:=ExtractFilePath(Application.ExeName)+'lang\rus.ini';
  cxlclzr1.Active:=True;
  cxlclzr1.Locale:=1049;
 end;
 prpstor1.StorageName:=ExtractFilePath(Application.ExeName)+'config\reestr';
 prpstor1.Active:=True;
 if FileExists(ExtractFilePath(Application.ExeName)+'config\reestr') then
   prpstor1.RestoreFrom;
 pgc1.ActivePage:=sht1;
 with DataSet2 do
 begin
    //без учета регистра
    FilterOptions:=[foCaseInsensitive];
    //динамическое изменение запроса
    AutoUpdateOptions.CanChangeSQLs:=True;
    AutoUpdateOptions.AutoReWriteSqls:=True;
 end;
  if (UserCod='2') or (UserCod='4') then
     btn_delete.Visible:=ivAlways else
     btn_delete.Visible:=ivNever;
  AddButton(self);
  NotExist:=TStringList.Create;
  MemIndex;
end;

procedure TNewReestrForm.v1DblClick(Sender: TObject);
begin
  OpenSpec(GetSelected('code',grd1));
end;

procedure TNewReestrForm.v1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key=VK_RETURN then
 begin
   //ShowMessage(GetSelected('code',grd1));
   OpenSpec(GetSelected('code',grd1));
 end;
end;

procedure TNewReestrForm.v2DataControllerFilterBeforeChange(
  Sender: TcxDBDataFilterCriteria; ADataSet: TDataSet;
  const AFilterText: string);
  var s,sql :string;
begin
 if pgc1.ActivePage<>sht2 then Exit;
 if AFilterText<>'' then
 begin
   sql:='select first :cnt code, reestr, accode, summa, lasttime,usr'+
      ' from n_reestrdata'+
      ' WHERE '+
      ' @@where_clause% 1 = 1 @';
   s:=CreateSqlClause(v2,'AND');
   if s<>'' then
   begin
      //открываем запрос
      OpenDataSets(s,sql,2000,DataSet2);
   end;
 end;
end;

procedure TNewReestrForm.OpenSpec(code :string);
var
  sql,s,iddoc :string;
begin
 //DataSet2.Close;
  // sql:='select code, reestr, accode, summa, lasttime,usr'+
  //    ' from n_reestrdata where reestr=:reestr';
   v2.DataController.BeginUpdate;
   v2.DataController.Filter.Root.Clear;
   v2.DataController.Filter.Root.AddItem(cl2reestr,foEqual,code,code);
   v2.DataController.EndUpdate;
   sql:='select first :cnt code, reestr, accode, summa, lasttime,usr'+
   ' from n_reestrdata '+
   ' WHERE '+
   ' @@where_clause% 1 = 1 @';
   s:=' reestr='+code;
   OpenDataSets(s,sql,2500,DataSet2);

 //DataSet2.SelectSQL.Text:=sql;
 //DataSet2.ParamByName('reestr').AsInteger:=StrToInt(code);
 //DataSet2.Open;
 if DataSet2.RecordCount>0 then
 begin
  sht2.TabVisible:=True;
  pgc1.ActivePage:=sht2;
 end;
end;

procedure TNewReestrForm.sht1Enter(Sender: TObject);
begin
 //pmn1.Grid:=grd1;
end;

procedure TNewReestrForm.sht2Enter(Sender: TObject);
begin
 //pmn1.Grid:=grd2;
end;
//панель загрузки из файла
procedure TNewReestrForm.btn_loadClick(Sender: TObject);
begin
 sht3.TabVisible:=True;
 pgc1.ActivePage:=sht3;
end;

procedure TNewReestrForm.cbb1PropertiesChange(Sender: TObject);
begin
// ShowMessage(cbb1.Properties.Grid.DataController.Values[cbb1.Properties.Grid.FocusedRowIndex,0]);
end;

procedure TNewReestrForm.btn_insertClick(Sender: TObject);
var
  kontragent :string;
begin
 kontragent:=VarToStr(cbb1.EditValue);
 //проверки
 if (FileExists(edt_file.Text)) and (kontragent<>'') and
 (dtdt1.Date<=dtdt2.Date) then
 begin
  //загружаем файл
  if not trn1.Active then trn1.Active:=True;
  LoadFileData(edt_file.Text,kontragent,dtdt1.Date,dtdt2.Date,true);
 end;
end;

{-------------------------------------------------------------------------------
  Процедура: TNewReestrForm.LoadFileData
  Автор:    Admin
  Дата:  2010.08.16
  Входные параметры:
  fname :string; имя файла
  kontragent :string; код контрагента
  d1 :TDateTime; период с
  d2 :TDateTime; период по
  full :Boolean  выгрузка с суммами (да/нет)
  Результат:    Нет
-------------------------------------------------------------------------------}
procedure TNewReestrForm.LoadFileData(fname,kontragent :string;
                                      d1,d2 :TDateTime; full :Boolean);
var
  ls :TStringList;
  i,reestr :Integer;
  sql :string;
  Q :TFIBQuery;
  RData :TDateTime;
begin
  sql:='select max(d1) d from n_reestr where kontragent=:kontr';
  Q:=GetQueryForUse(trn1,sql);
  Q.ParamByName('kontr').AsString:=kontragent;
  try
    Q.ExecQuery;
    RData:=Q.FN('d').AsDateTime;
    if d1<RData then
    begin
      ShowMessage(' Дата нового реестра'+#10#13+
                  ' не может быть меньше даты уже загруженного'+#10#13+
                  ' реестра по выбраному контрагенту.'+#10#13+
                  ' Загрузка отменена.');
      FreeQueryForUse(Q);
      Exit;
    end;
  finally

  end;
  ls:=TStringList.Create;
  ls.LoadFromFile(fname);
  if ls.Count>0 then
  begin
    reestr:=CreateHead(kontragent,d1,d2,ls.Count);
    InsertData(reestr,ls);
    trn1.Commit;
  end;
  FreeQueryForUse(Q);
  ls.Free;
  pgc1.ActivePage:=sht1;
  sht3.TabVisible:=False;
  DataSet1.CloseOpen(False);
  if NotExist.Text<>'' then
  begin
    NotExist.SaveToFile(
                  ExtractFilePath(Application.ExeName)+'пропущенные счета.txt');
    ShowMessage('Пропущенные счета сохранены в файл '+#10#13+
    ExtractFilePath(Application.ExeName)+'пропущенные счета.txt');
  end;

end;
{-------------------------------------------------------------------------------
IsExist|Проверка счета на существование
-------------------------------------------------------------------------------}
function TNewReestrForm.IsExist(AcCode :string) :boolean;
var
  Q :TFIBQuery;
begin
  Result:=False;
  Q:=GetQueryForUse(trn1,'select Code from spr$schet where code=:AcCode and '+
                    'KONTRAGENT=:kontr');
  Q.ParamByName('AcCode').AsString:=AcCode;
  Q.ParamByName('kontr').AsString:=VarToStr(cbb1.EditValue);
  Q.ExecQuery;
  if Q.FN('Code').AsString<>'' then
  Result:=True;
end;

// вставляем данные
procedure TNewReestrForm.InsertData(reestr :Integer; ls :TStringList);
var
  Q,QUsr :TFIBQuery;
  sql,acccode,sum,ch :string;
  i,usr,n :Integer;
  f: double;
  RData :TDateTime;
begin
  sql:='insert into n_reestrdata (code, reestr, accode, summa,usr,KONTRAGENT)'+
       ' values (0, :reestheadcode, :ACCCODE, :summa, :usr, :KONTRAGENT);';
  Q:=GetQueryForUse(trn1,sql);
  QUsr:=GetQueryForUse(trn1,'Select usr from reestr where accCode=:accCode');
  if Copy(VarToStr(cbb1.EditValue),1,1)='*' then
  ch:='*' else ch:='';
  for I := 0 to Ls.Count - 1 do
  begin
    try
    acccode:=GetWord(ls.Strings[i],1,#9);
    if Length(acccode)=8 then acccode:='0'+AccCode;
    acccode:=ch+acccode;
    //если есть сумма
    if WordCount(ls.Strings[i],#9)>1 then
    begin
      sum:=CorrectFloat(GetWord(ls.Strings[i],2,#9));
      for n:=1 to Length(sum) -1 do begin
        if sum[n]=#32 then  Delete(sum,n,1);
      end;
    end else sum:='0';
    //получаем пользователя
    QUsr.Prepare;
    QUsr.ParamByName('AccCode').AsString:=acccode;
    QUsr.ExecQuery;
    if QUsr.FN('usr').AsInteger>0 then usr:=QUsr.FN('usr').AsInteger
                                  else usr:=edt3.AsInteger;
    if IsExist(acccode)=true then
    begin
      Q.Prepare;
      Q.ParamByName('reestheadcode').AsInteger:=reestr;
      Q.ParamByName('acccode').AsString:=acccode;
      Q.ParamByName('summa').AsFloat:=StrToFloat(sum);
      Q.ParamByName('usr').AsInteger:=usr;
      Q.ParamByName('KONTRAGENT').AsString:=
                    VarToStr(cbb1.Properties.Grid.DataController.Values[
                                       cbb1.Properties.Grid.FocusedRowIndex,0]);
      Q.ExecQuery;
    end else
      NotExistSchet(acccode);
    finally

    end;
  end;
  FreeQueryForUse(Q); FreeQueryForUse(QUsr);
end;

procedure TNewReestrForm.NotExistSchet(AcCode :string);
begin
  NotExist.Add('Счет '+AcCode+' пропущен.');
end;

//создаем шапку
function TNewReestrForm.CreateHead(kontragent :string; d1,d2 :TDateTime; cnt:integer) :integer;
var
  Q,Q1 :TFIBQuery;
  sql :string;
  code :Integer;
begin
  //получаем будущий код документа
  sql:='select Gen_id(N_Reestr_Gen, 1) code from rdb$database';
  Q1:=GetQueryForUse(trn1,sql);
  Q1.ExecQuery;
  code:=Q1.FN('Code').AsInteger;
  FreeQueryForUse(Q1);
  //создаем шапку документа
  sql:='insert into n_reestr (code, kontragent, note, d1, d2, cnt)'+
       ' values (:reestheadcode, :codekontr,:note, :d1, :d2, :cnt);';
  try
    Q:=GetQueryForUse(trn1,sql);
    Q.Prepare;
    Q.ParamByName('reestheadcode').AsInteger:=code;
    Q.ParamByName('codekontr').AsString:=kontragent;
    Q.ParamByName('d1').AsDateTime:=d1;
    Q.ParamByName('d2').AsDateTime:=d2;
    Q.ParamByName('note').AsString:=edt_note.Text;
    Q.ParamByName('cnt').AsInteger:=cnt;
    Q.ExecQuery;
  finally
    FreeQueryForUse(Q);
  end;
   Result:=code;
end;

procedure TNewReestrForm.edt3Change(Sender: TObject);
var
  Q :TFIBQuery;
begin
  try
    if not trn1.Active then trn1.Active:=True;
    Q:=GetQueryForUse(trn1,'select name from SPR$USERS where code=:code');
    Q.Prepare;
    Q.ParamByName('code').AsInteger:=edt3.AsInteger;
    Q.ExecQuery;
    edt2.Text:=Q.FN('Name').AsString;
  finally
    FreeQueryForUse(Q);
  end;
end;

procedure TNewReestrForm.sht3Enter(Sender: TObject);
begin
 DataSet3.CloseOpen(False);
 edt3.EditText:='2';//UserCod;
 ds_reestr.CloseOpen(true);
end;
{------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
  btn_loadIndexClick|Загрузка индексов
-------------------------------------------------------------------------------}
procedure TNewReestrForm.btn_loadIndexClick(Sender: TObject);
var
  i :Integer;
begin
  if CheckParam then
  begin
    mt_index.Close;
    mt_index.Open;
    //
    xlsImp2.FileName:=edt_index.FileName;
    xlsImp2.Execute;
    if mt_index.RecordCount>0 then
    begin
      i:=MakeScript;
      if ExScript then
      ShowMessage('Индексы лицевых счетов установлены.');
    end;
  end;
end;

function TNewReestrForm.ExScript :boolean;
begin
  if dm1.trnWr.Active then  dm1.trnWr.Active:=False;
  with script1 do
  begin
    Database:=dm1.db1;
    Transaction:=dm1.trnWr;
    try
       try
          dm1.trnWr.StartTransaction;
          ExecuteScript;
          dm1.trnWr.Commit;
          Result:=True;
       except
          on E :Exception do
          begin
           dm1.trnWr.Rollback;
           Result:=False;
          end;
       end;
    finally
      if not dm1.trnWr.Active then
      dm1.trnWr.StartTransaction;
    end;
  end;
end;

function TNewReestrForm.CheckParam :Boolean;
begin
  Result:=True;
  if not FileExists(edt_index.FileName) then
  begin
    ShowMessage('Не найден файл индексов!');
    Result:=False;
    Exit;
  end;
  if cbb_reestr.EditValue=null then
  begin
    ShowMessage('Не указан реестр!');
    Result:=False;
    Exit;
  end;
end;

function TNewReestrForm.MakeScript :integer;
var
  ACCODE,AINDEX,REESTR :string;
begin
  script1.Script.Clear;
  REESTR:=cbb_reestr.EditValue;
  while not mt_index.Eof do
  begin
    ACCODE:=#39+mt_index.FieldByName('ACCODE').AsString+#39;
    AINDEX:=mt_index.FieldByName('AINDEX').AsString;
    script1.Script.Add(
    'update N_REESTRDATA set AINDEX = '+AINDEX+
    ' where ACCODE = '+ACCODE+' and REESTR = '+REESTR+';');
    mt_index.Next;
  end;
  if script1.Script.Count>0 then
  Result:=script1.Script.Count else
  Result:=0;
  //script1.Script.SaveToFile('test.sql');
end;

procedure TNewReestrForm.MemIndex;
begin
  CreateField(mt_index,'ACCODE',ftString,32);
  //CreateField(mt_index,'REESTR',ftInteger);
  CreateField(mt_index,'AIndex',ftInteger);
  mt_index.Open;
end;

end.
